insert Subroutine

public pure subroutine insert(iopt, t, n, c, k, x, tt, nn, cc, nest, ier)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: iopt
real(kind=RKIND), intent(in) :: t(nest)
integer, intent(in) :: n
real(kind=RKIND), intent(in) :: c(nest)
integer, intent(in) :: k
real(kind=RKIND), intent(in) :: x
real(kind=RKIND), intent(out) :: tt(nest)
integer, intent(out) :: nn
real(kind=RKIND), intent(out) :: cc(nest)
integer, intent(in) :: nest
integer, intent(out) :: ier

Source Code

      pure subroutine insert(iopt,t,n,c,k,x,tt,nn,cc,nest,ier)

      !
      !  calling sequence:
      !     call insert(iopt,t,n,c,k,x,tt,nn,cc,nest,ier)
      !
      !  input parameters:
      !    iopt : integer flag, specifying whether (iopt/=0) or not (iopt=0) the given spline must be
      !           considered as being periodic.
      !    t    : array,length nest, which contains the position of the knots.
      !    n    : integer, giving the total number of knots of s(x).
      !    c    : array,length nest, which contains the b-spline coefficients.
      !    k    : integer, giving the degree of s(x).
      !    x    : real, which gives the location of the knot to be inserted.
      !    nest : integer specifying the dimension of the arrays t,c,tt and cc. nest > n.
      !
      !  output parameters:
      !    tt   : array,length nest, which contains the position of the knots after insertion.
      !    nn   : integer, giving the total number of knots after insertion
      !    cc   : array,length nest, which contains the b-spline coefficients of s(x) with respect to the
      !           new set of knots.
      !    ier  : error flag
      !      ier = 0 : normal return
      !      ier =10 : invalid input data (see restrictions)
      !
      !  restrictions:
      !    nest > n
      !    t(k+1) <= x <= t(n-k)
      !    in case of a periodic spline (iopt/=0) there must be either at least k interior knots t(j)
      !       satisfying t(k+1)<t(j)<=x or at least k interior knots t(j) satisfying x<=t(j)<t(n-k)
      !
      !  other subroutines required: fpinst.
      !
      !  further comments:
      !   subroutine insert may be called as follows
      !        call insert(iopt,t,n,c,k,x,t,n,c,nest,ier)
      !   in which case the new representation will simply replace the old one
      !
      !  references :
      !    boehm w : inserting new knots into b-spline curves. computer aided design 12 (1980) 199-201.
      !   dierckx p. : curve and surface fitting with splines, monographs on numerical analysis, oxford
      !                university press, 1993.
      !
      !  author :
      !    p.dierckx
      !    dept. computer science, k.u.leuven
      !    celestijnenlaan 200a, b-3001 heverlee, belgium.
      !    e-mail : Paul.Dierckx@cs.kuleuven.ac.be
      !
      !  ..scalar arguments..
      integer, intent(in)      :: iopt,n,k,nest
      integer, intent(out)     :: nn,ier
      real(RKIND), intent(in)  :: x
      !  ..array arguments..
      real(RKIND), intent(in)  :: t(nest),c(nest)
      real(RKIND), intent(out) :: tt(nest),cc(nest)
      !  ..local scalars..
      integer :: kk,k1,l,nk,nk1
      !  ..
      !  before starting computations a data check is made. if the input data
      !  are invalid control is immediately repassed to the calling program.
      ier = FITPACK_INPUT_ERROR
      if (nest<=n) return
      k1 = k+1
      nk = n-k
      if (x<t(k1) .or. x>t(nk)) return
      !  search for knot interval t(l) <= x < t(l+1).
      nk1 = nk-1
      l = k1
      do while (x>=t(l+1) .and. l/=nk1)
         l = l+1
      end do

      !  no interval found in whole range
      if(t(l)>=t(l+1)) return

      if(iopt/=0) then
         kk = 2*k
         if (l<=kk .and. l>=(n-kk)) return
      endif

      ier = FITPACK_OK
      !  insert the new knot.
      call fpinst(iopt,t,n,c,k,x,l,tt,nn,cc,nest)

      end subroutine insert